Optional Spritesets.f

Requires Stacks
Requires Tools
Requires KAGI

Only Forth Definitions

\ Read-only form - disposes names and trailing blank sprites and frames
/Image-based inherit
   cell field ->frames   \ array of subimages
   cell field ->sprites  \ array of sprites (indices + names) - may be left unused if there isn't animation data
End-struct /Spriteset

16 constant /Sprite  \ first-frame h, counted-name (max 13 chars) - examples: "MON1-WALK" "RPTR-EXPLODE"

\ Modifiable form - large data structure
/Spriteset Inherit
   1024 /Subimage * field ->frametable
   512 /Sprite * field ->spritetable
End-struct /Editable-Spriteset

: /fill   here over allot swap 255 fill ;

: sprite[]  ( n spriteset -- sprite )
   ->sprites @ swap 4 lshift + ;
: frame[]   ( n spriteset -- subimage )
   ->frames @ swap 4 lshift + ;

: slurp   -rot read-file throw drop ;

\ Spriteset File Format:  headersize , #frames , #sprites , 0 , data ...

: get-spriteset-size  ( filename count -- #frames #sprites )
   file:[ pad slurp ;] pad cell+ @+ swap @ ;

: load-spriteset  ( filename count frametable spritetable -- )
   locals| spritetable frametable |
   file:[ pad slurp
      pad dup @ +  frametable  pad cell+ @  /subimage *  move
      pad dup @ +  pad cell+ @ /subimage * +  spritetable  pad cell+ cell+ @  /sprite *  move
   ;] ;

: Spriteset:  ( filename count -- <name> )
   Create /Spriteset /allot
   2dup get-spriteset-size   ( #frames #sprites )
   here ( spritetable ) dup lastbody ->sprites ! >r  /sprite * /fill
   here ( frametable ) dup lastbody ->frames ! >r  /subimage * /fill
   r> r> load-spriteset
   ; \ lastbody ->image ! ;


\ Sprites
: sprite@name   ( sprite# spriteset -- name count ) sprite[] 2 + count ;
: first-frame    ( sprite# spriteset -- frame ) sprite[] h@ ;

\ Frames
: next-frame   (  n spriteset -- n ) frame[] @next ;
: find-frame   (  sprite#  index  spriteset -- frame# )
   locals| sprset |
   sprset  first-frame  swap  0 ?do  sprset  next-frame loop ;


\ LAST-FRAME - this could be used to detect the loop point and we could store it in the sprite, after we are done with the name
\ If a sprite is non looping, last frame jumps to -1, if looping, last frame jumps to start of loop.
1000 Stack: framestack

: (in-framestack)
   framestack stack-count 0 ?do @+ third = if unloop 2drop true exit then loop 2drop false ;

: last-frame  (  sprite#  spriteset -- frame# )
   locals| sprset |
   framestack clear-stack
   sprset first-frame begin
      dup framestack push
      dup sprset next-frame dup  -1 = if drop exit then
      dup (in-framestack) if drop exit then
      nip
   again ;


\ Modification

{
0 value sprset

: active?   @ 0< not ;

: Editable-spriteset:
   Create /Editable-Spriteset /fill
   lastbody ->spritetable lastbody ->sprites !
   lastbody ->frametable lastbody ->frames ! ;
}
